home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue58 / DragDrop / ClipFmtListU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-05-03  |  6.8 KB  |  252 lines
  1. unit ClipFmtListU;
  2.  
  3. {$ifdef Ver100} { Delphi 3.0x }
  4.   {$define DelphiLessThan4}
  5. {$endif}
  6. {$ifdef Ver110} { C++ Builder 3.0x }
  7.   {$define DelphiLessThan4}
  8. {$endif}
  9.  
  10. interface
  11.  
  12. uses
  13.   ActiveX,
  14.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  15.   ComCtrls, Menus, ExtCtrls;
  16.  
  17. type
  18.   TDataFormatListForm = class(TForm, IUnknown, IDropTarget)
  19.     lstDragFmt: TListView;
  20.     Splitter1: TSplitter;
  21.     lstClipFmt: TListView;
  22.     Timer: TTimer;
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure FormDestroy(Sender: TObject);
  25.     procedure TimerTimer(Sender: TObject);
  26.     procedure FormShow(Sender: TObject);
  27.     procedure FormHide(Sender: TObject);
  28.   private
  29.   {$ifdef DelphiLessThan4}
  30.     //IUnknown
  31.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  32.     function _AddRef: Integer; stdcall;
  33.     function _Release: Integer; stdcall;
  34.   {$endif}
  35.     //IDropTarget
  36.     function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
  37.       pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  38.     function DragOver(grfKeyState: Longint; pt: TPoint;
  39.       var dwEffect: Longint): HResult;
  40.       {$ifndef DelphiLessThan4}reintroduce; {$endif}stdcall;
  41.     function DragLeave: HResult; stdcall;
  42.     function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  43.       var dwEffect: Longint): HResult; stdcall;
  44.     //Other methods
  45.     procedure ListFormats(List: TListItems; DataObj: IDataObject);
  46.   end;
  47.  
  48. var
  49.   DataFormatListForm: TDataFormatListForm;
  50.  
  51. implementation
  52.  
  53. {$R *.DFM}
  54.  
  55. uses
  56.   ComObj;
  57.  
  58. function ClipFormatToStr(Fmt: TClipFormat): String;
  59. var
  60.   Buf: array[0..255] of Char;
  61. begin
  62.   GetClipboardFormatName(Fmt, Buf, SizeOf(Buf));
  63.   Result := String(Buf);
  64.   if Result = '' then
  65.     case Fmt of
  66.       CF_TEXT:            Result := 'CF_TEXT';
  67.       CF_BITMAP:          Result := 'CF_BITMAP';
  68.       CF_METAFILEPICT:    Result := 'CF_METAFILEPICT';
  69.       CF_SYLK:            Result := 'CF_SYLK';
  70.       CF_DIF:             Result := 'CF_DIF';
  71.       CF_TIFF:            Result := 'CF_TIFF';
  72.       CF_OEMTEXT:         Result := 'CF_OEMTEXT';
  73.       CF_DIB:             Result := 'CF_DIB';
  74.       CF_PALETTE:         Result := 'CF_PALETTE';
  75.       CF_PENDATA:         Result := 'CF_PENDATA';
  76.       CF_RIFF:            Result := 'CF_RIFF';
  77.       CF_WAVE:            Result := 'CF_WAVE';
  78.       CF_UNICODETEXT:     Result := 'CF_UNICODETEXT';
  79.       CF_ENHMETAFILE:     Result := 'CF_ENHMETAFILE';
  80.       CF_HDROP:           Result := 'CF_HDROP';
  81.       CF_LOCALE:          Result := 'CF_LOCALE';
  82.       CF_OWNERDISPLAY:    Result := 'CF_OWNERDISPLAY';
  83.       CF_DSPTEXT:         Result := 'CF_DSPTEXT';
  84.       CF_DSPBITMAP:       Result := 'CF_DSPBITMAP';
  85.       CF_DSPMETAFILEPICT: Result := 'CF_DSPMETAFILEPICT';
  86.       CF_DSPENHMETAFILE:  Result := 'CF_DSPENHMETAFILE';
  87.     else
  88.       Result := 'Unknown clipboard format'
  89.     end;
  90.   Result := Format('%s (%d, $%1:x)', [Result, Fmt])
  91. end;
  92.  
  93. function TyMedToStr(TyMed: Longint): String;
  94. var
  95.   I: Integer;
  96.   Started: Boolean;
  97. type
  98.   TTyMed = record
  99.     TyMed: Longint;
  100.     Desc: String
  101.   end;
  102. const
  103.   TyMeds: array[0..6] of TTyMed = (
  104.     (TyMed: TYMED_HGLOBAL;  Desc: 'TYMED_HGLOBAL'),
  105.     (TyMed: TYMED_FILE;     Desc: 'TYMED_FILE'),
  106.     (TyMed: TYMED_ISTREAM;  Desc: 'TYMED_ISTREAM'),
  107.     (TyMed: TYMED_ISTORAGE; Desc: 'TYMED_ISTORAGE'),
  108.     (TyMed: TYMED_GDI;      Desc: 'TYMED_GDI'),
  109.     (TyMed: TYMED_MFPICT;   Desc: 'TYMED_MFPICT'),
  110.     (TyMed: TYMED_ENHMF;    Desc: 'TYMED_ENHMF'));
  111. begin
  112.   Result := '';
  113.   Started := False;
  114.   for I := Low(TyMeds) to High(TyMeds) do
  115.   begin
  116.     if TyMed and TyMeds[I].TyMed <> 0 then
  117.     begin
  118.       if Started then
  119.         Result := Result + ' or ';
  120.       Result := Result + TyMeds[I].Desc;
  121.       Started := True
  122.     end
  123.   end;
  124. end;
  125.  
  126. {$ifdef DelphiLessThan4}
  127. //IUnknown
  128. function TDataFormatListForm._AddRef: Integer;
  129. begin
  130.   if VCLComObject = nil then
  131.     Result := -1   // -1 indicates no reference counting is taking place
  132.   else
  133.     Result := IVCLComObject(VCLComObject)._AddRef;
  134. end;
  135.  
  136. function TDataFormatListForm._Release: Integer;
  137. begin
  138.   if VCLComObject = nil then
  139.     Result := -1   // -1 indicates no reference counting is taking place
  140.   else
  141.     Result := IVCLComObject(VCLComObject)._AddRef;
  142. end;
  143.  
  144. function TDataFormatListForm.QueryInterface(const IID: TGUID;
  145.   out Obj): HResult;
  146. begin
  147.   if VCLComObject = nil then
  148.   begin
  149.     if GetInterface(IID, Obj) then Result := S_OK
  150.     else Result := E_NOINTERFACE
  151.   end
  152.   else
  153.     Result := IVCLComObject(VCLComObject).QueryInterface(IID, Obj);
  154. end;
  155. {$endif}
  156.  
  157. //IDropTarget
  158. function TDataFormatListForm.DragEnter(const dataObj: IDataObject;
  159.   grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
  160. begin
  161.   ListFormats(lstDragFmt.Items, dataObj);
  162.   Result := S_OK
  163. end;
  164.  
  165. function TDataFormatListForm.DragLeave: HResult;
  166. begin
  167.   Result := S_OK
  168. end;
  169.  
  170. function TDataFormatListForm.DragOver(grfKeyState: Integer; pt: TPoint;
  171.   var dwEffect: Integer): HResult;
  172. begin
  173.   Result := S_OK
  174. end;
  175.  
  176. function TDataFormatListForm.Drop(const dataObj: IDataObject;
  177.   grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
  178. begin
  179.   DragLeave; //Call routine that potentially does tidying up
  180.   Result := S_OK
  181. end;
  182.  
  183. procedure TDataFormatListForm.FormCreate(Sender: TObject);
  184. begin
  185.   //
  186. end;
  187.  
  188. procedure TDataFormatListForm.FormDestroy(Sender: TObject);
  189. begin
  190.   //
  191. end;
  192.  
  193. procedure TDataFormatListForm.FormShow(Sender: TObject);
  194. var
  195.   Res: HResult;
  196. begin
  197.   Res := RegisterDragDrop(lstDragFmt.Handle, Self);
  198.   OleCheck(Res);
  199.   //OleCheck(RegisterDragDrop(lstDragFmt.Handle, Self));
  200.   //Make sure timer ticks immediately
  201.   if Assigned(Timer.OnTimer) then
  202.     Timer.OnTimer(Timer)
  203. end;
  204.  
  205. procedure TDataFormatListForm.FormHide(Sender: TObject);
  206. begin
  207.   OleCheck(RevokeDragDrop(lstDragFmt.Handle))
  208. end;
  209.  
  210. procedure TDataFormatListForm.ListFormats(List: TListItems;
  211.   DataObj: IDataObject);
  212. var
  213.   EFE: IEnumFormatEtc; //enumeration interface
  214.   FE: TFormatEtc; //Clipboard format, storage medium type etc.
  215.   CElt: Longint; //count of elements returned
  216.   Item: TListItem;
  217. begin
  218.   OleCheck(dataObj.EnumFormatEtc(DATADIR_GET, EFE));
  219.   List.BeginUpdate;
  220.   try
  221.     List.Clear;
  222.     CElt := -1;
  223.     while CElt <> 0 do
  224.     begin
  225.       OleCheck(EFE.Next(1, FE, @CElt));
  226.       if CElt > 0 then
  227.       begin
  228.         Item := List.Add;
  229.         Item.Caption := ClipFormatToStr(FE.cfFormat);
  230.         Item.SubItems.Add(TyMedToStr(FE.tymed));
  231.       end
  232.     end
  233.   finally
  234.     List.EndUpdate
  235.   end;
  236. end;
  237.  
  238. procedure TDataFormatListForm.TimerTimer(Sender: TObject);
  239. var
  240.   DataObj: IDataObject;
  241. begin
  242.   if Succeeded(OleGetClipboard(DataObj)) then
  243.     ListFormats(lstClipFmt.Items, DataObj)
  244. end;
  245.  
  246.  
  247. initialization
  248.   OleCheck(OleInitialize(nil))
  249. finalization
  250.   OleUninitialize
  251. end.
  252.